#! /usr/bin/perl
use strict;
use Getopt::Long;

my $rename = '';
my $help;
my $addcode = '';

my $usage = <<EOT;

fugen - interface generator for HelFORTH
Copyright (c) 2006 Helmar Wodtke

usage:
  $0 [options] include.h [-- cpp_options]

where options include:

  -rename '..script..'      define rename script
  -addcode '...'            additional C code
  -help                     display help screen

EOT

GetOptions (
  "help" => \$help,
  "h" => \$help,
  "rename=s" => \$rename,
  "addcode=s" => \$addcode,
) or die $usage;

if ($help || $#ARGV < 0) {
  print $usage;
  exit 0;
}

my $input = shift @ARGV;

print "|\n| from $input\n|\n";
my @def;
open FUGEN, ">fugen.c" or die;
print FUGEN "$addcode\n#include <$input>\n";
close FUGEN;
open CPP, "cpp fugen.c @ARGV|indent -bfda|" or die;
my $file = $input;
$file =~ s:^([^\/]+\/)+::;
my $ofile = $file;
my $carg = "cairo_t*";
while (<CPP>) {
#  print STDERR $_;
  /^# \d+ .*["\/]([^\/"]+)"/ and $file = $1;
  /^#/ and next;
  /^$/ and next;
  next if $file ne $ofile;
  s/ __attribute__ \(\(.*\)\)//g;
  /^{.*}/ and next;
  /^{/ ..
    /^}/ and next;
  /^((typedef)|(struct)) / and next;
  s/^(((extern)|(const)) )+//;
  s/^  (__)?const /  /;
  s/ \*/* /g;
  s/\*/* /g;
  s/,$//;
  s/\s\s+/ /g;
  s/^(.*)\);?/)/ and push @def, "$1\n";
  s/^\s*;\s*$//;
  push @def, $_;
}

# print STDERR join('', @def);

my (@proto, $ret);
our $funa;
my @outlist;
for (@def) {
  if (/^(\S+) ((\S+) )*(\S+) \(/) {
    $funa = $4;
    eval $rename;
    $ret = $1;
    @proto = ();
  } elsif (/^ (\S+)/) {
    push @proto, $1;
  } elsif (/^\)/) {
    next if not defined $funa;
    if ($proto[-1] eq "...") {
      print STDERR "can not use $funa() because of varargs\n";
      next;
    }
    my $proto = "";
    if ($#proto == 0 && $proto[0] eq "void") {
      $proto = "0";
    } else {
      for (@proto) {
        if ($_ eq "double") {
          $proto .= "d";
        } elsif ($_ eq $carg) {
          $proto .= "c";
        } else {
          $proto .= "n";
        }
      }
    }
    push @outlist, [ $proto, $funa ];
    push @{$outlist[-1]}, "void" if $ret eq "void";
    $funa = undef;
  } elsif (/^\s*$/) {
  } else {
    print STDERR "something wrong with: $_";
  }
}
my @widths;
for (@outlist) {
  $widths[0] = length($_->[0]) if length($_->[0]) > $widths[0];
  $widths[1] = length($_->[1]) if length($_->[1]) > $widths[1];
}
for (@outlist) {
  print "  ifgen: ", " " x($widths[0] - length($_->[0])), $_->[0];
  print " $_->[1]";
  if (defined $_->[2]) {
    print " "x($widths[1] - length($_->[1])), " $_->[2]";
  }
  print "\n";
}
